PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/arith2.com/DECODE.PAS

Pascal/Delphi Source File | 1989-02-27 | 5.7 KB | 206 lines

PROGRAM decode;

{$F+}

        { ------------------------------------------------------------------

          This program and its associates implement in Turbo Pascal v5
          the aritmetic encoding/decoding algorithms presented in the papers

          "Arithmetic Coding for Data Compression"

                   by Ian     H. Witten
                      Radford M. Neal
                      John    G. Cleary

          pp 520 - 540 of June 1987 Communications of the ACM

          and

          "An Adaptive Dependency Source Model For Data Compression"

                   by David M. Abrahamson

          pp 77 - 83 of January 1989 Communications of the ACM

          ------------------------------------------------------------------

          Implemented by Ken Westerback : CompuServe 73547,3520

          version 1.0 released 89/02/19
          version 2.0 released 89/02/27

          These programs, units and associated documentation are released
          into the public domain to be used and abused as your whims
          dictate.

          Feel free to distribute/incorporate/improve as desired.

          >>>>> Use at your own risk! <<<<<

          Comments and suggestions welcome via CompuServe.

          ------------------------------------------------------------------
        }

        USES overlay
            ,dos
            ,arith_de   { arithmetic decoding procedures                   }
            ,fix_mod    { fixed coding model                               }
            ,adap_mod   { adaptive coding model                            }
            ,adp_mod    { adaptive dependency source model implementation  }
            ;

{$O fix_mod }
{$O adap_mod}
{$O adp_mod }

var    symbol : integer;
     chars_in : longint;
    chars_out : longint;
      decoded : file;

     char_buf : array[ 0..2047] of char; { chunks we write decoded in }
 chars_in_buf : word;

  select_char : function  ( symbol : integer ) : char;
 update_model : procedure ( symbol : integer );

   model_name : string;

procedure open_files;

          var     s : pathstr;
              model : char;

          begin

          { first parameter is file to decode into                   }
          {                                                          }
          { note : will overwrite any existing file of the same name }

          if ( paramcount < 2 ) then
             begin
             writeln ;
             writeln ( 'usage : decode <output file> <encoded file>' );
             writeln ;
             halt;
             end;

          writeln ;
          write   ( '"', paramstr ( 1 ), '" will be decoded from "'
                       , paramstr ( 2 ), '"'
                  );

          assign  ( decoded, paramstr ( 1 ) );
          Rewrite ( decoded, 1 );

          if ( IOResult <> 0 ) then
             begin
             writeln ;
             writeln ( 'decode can''t create output file : ', paramstr(1) );
             writeln ;
             end;

          model := start_decoding ( paramstr(2) );

          ovrinit ( 'decode.ovr' );

          if ovrresult <> ovrok then
             begin
             writeln;
             writeln ( 'encode : overinit failed (', ovrresult, ')' );
             writeln;
             halt;
             end;

          case model of
             'f' : begin
                   model_name   := fix_mod.model_name;
                   fix_mod.start_model;
                   select_char  := fix_mod.select_char;
                   update_model := fix_mod.update_model;
                   end;

             'a' : begin
                   model_name   := adap_mod.model_name;
                   adap_mod.start_model;
                   select_char  := adap_mod.select_char;
                   update_model := adap_mod.update_model
                   end;

             'd' : begin
                   model_name   := adp_mod.model_name;
                   adp_mod.start_model;
                   select_char  := adp_mod.select_char;
                   update_model := adp_mod.update_model;
                   end;

             else  begin
                   writeln;
                   writeln ( 'decode : invalid model "', model, '"' );
                   writeln;
                   halt;
                   end;

             end; { model case }

          writeln ( ' using ', model_name );
          writeln ;

          chars_out    := 0;
          chars_in_buf := 0;

          fillchar ( char_buf, sizeof(char_buf), 0 );

          end; { open files }

procedure close_files;
          begin

          inc ( chars_out, chars_in_buf );

          blockwrite ( decoded, char_buf, chars_in_buf, chars_in_buf );

          chars_in := done_decoding;

          close ( decoded );

          end; { close_files }


BEGIN

writeln ;
writeln ( 'TPascal Arithmetic Coding, by Ken Westerback, version 2.0 89/02/27' );

open_files;

while decode_symbol ( symbol ) do
      begin

      char_buf[ chars_in_buf ] := select_char ( symbol );

      update_model ( symbol );

      inc ( chars_in_buf );

      if chars_in_buf = 2048 then
         begin
         blockwrite ( decoded, char_buf, chars_in_buf, chars_in_buf );
         fillchar ( char_buf, sizeof(char_buf), 0 );
         inc ( chars_out, sizeof(char_buf) );
         chars_in_buf := 0;
         end;

      end; { of valid symbol to decode }

close_files;

writeln ( '   characters read    : ', chars_in  );
writeln ( '   characters written : ', chars_out );
writeln ;
writeln ( '   ', ((chars_out/chars_in)*100):5:2, ' % expansion' );

END. { arithmetic decoding }